module vector_mod
   implicit none
   type::T
      class(*),allocatable::t_
   end type T
   type::vector
      type(T),allocatable::x_(:)
      integer::dim_
      integer::capacity_
   contains
      generic::vector_init  =>vector_init_array,vector_init_int
      generic::vector_append=>vector_append_val,vector_append_array
      generic::vector_print =>vector_print_val,vector_print_array,vector_print_all
      procedure,pass::vector_init_array
      procedure,pass::vector_init_int
      procedure,pass::vector_append_val
      procedure,pass::vector_append_array
      procedure,pass::vector_print_val
      procedure,pass::vector_print_array
      procedure,pass::vector_print_all
      final::vector_final
   end type vector

   abstract interface
      subroutine sub(x)
         class(*),intent(in)::x
      end subroutine sub
      function func(x)result(res)
         class(*),intent(in)::x
         class(*),allocatable::res
      end function func
   end interface
contains
   subroutine vector_init_int(this,n)
      class(vector),intent(inout)::this
      integer,intent(in)::n
      this%dim_= n
      this%capacity_=n+10
      allocate(this%x_(n+10))
   end subroutine vector_init_int

   subroutine vector_init_array(this,a_)
      class(vector),intent(inout)::this
      class(*),intent(in)::a_(:)
      integer::n,i
      n=size(a_)
      call this%vector_init_int(n)
      do i=1,n
         allocate(this%x_(i)%t_,source=a_(i))
      end do
   end subroutine

   subroutine vector_append_val(this,a_)
      class(vector),intent(inout)::this
      class(*),intent(in)::a_
      if(this%dim_==this%capacity_)then
         move:block
            type(T),allocatable::tmp_(:)
            integer::i
            this%capacity_=this%capacity_+this%capacity_/3+1
            allocate(tmp_(this%capacity_))
            do i=1,this%dim_
               tmp_(i)=this%x_(i)
            end do
            this%dim_=this%dim_+1
            allocate(tmp_(this%dim_)%t_,source=a_)
            deallocate(this%x_)
            call move_alloc(tmp_,this%x_)
         end block move
      else
            this%dim_=this%dim_+1
            allocate(this%x_(this%dim_)%t_,source=a_)
      end if
   end subroutine vector_append_val

   subroutine vector_append_array(this,a_)
      class(vector),intent(inout)::this
      class(*),intent(in)::a_(:)
      integer::n_
      integer::i
      n_=size(a_)
      if(this%dim_+n_ > this%capacity_)then
         move:block
            type(T),allocatable::tmp_(:)
            integer::i
            this%capacity_=this%capacity_+this%capacity_/3 + n_ + n_ /3
            allocate(tmp_(this%capacity_))
            do i=1,this%dim_
               tmp_(i)=this%x_(i)
            end do
            do i=1,n_
               allocate(tmp_(this%dim_+i)%t_,source=a_(i))
            end do
            this%dim_=this%dim_+n_
            deallocate(this%x_)
            call move_alloc(tmp_,this%x_)
         end block move
      else
            do i=1,n_
               allocate(this%x_(this%dim_+i)%t_,source=a_(i))
            end do
            this%dim_=this%dim_+n_
      end if
   end subroutine vector_append_array

   recursive subroutine vector_print_val(this,f,i)
      class(vector),intent(in)::this
      procedure(sub)::f
      integer,intent(in)::i
      select type(x=>this%x_(i)%t_)
      type is (vector)
         call x%vector_print_all(f)
      class default
         call f(x)
      end select
   end subroutine vector_print_val

   subroutine vector_print_array(this,f,a_)
      class(vector),intent(in)::this
      procedure(sub)::f
      integer,intent(in)::a_(:)
      integer::i
      do i=1,size(a_)
         call this%vector_print_val(f,a_(i))
      end do
   end subroutine vector_print_array

   recursive subroutine vector_print_all(this,f)
      class(vector),intent(in)::this
      procedure(sub)::f
      integer::i
      write(*,"(g0)",advance="no")"["
      do i=1,this%dim_
         call this%vector_print_val(f,i)
      end do
      write(*,"(A1,A2)",advance="no")char(8),"],"
   end subroutine vector_print_all

   subroutine vector_final(this)
      type(vector),intent(inout)::this
      deallocate(this%x_)
   end subroutine vector_final
end module vector_mod

program main
   use vector_mod
   implicit none
   type(vector)::x,y,z
   class(*),allocatable::a
   call x%vector_init([1,2,3,4])
   call y%vector_init([9,10,11,12])
   call x%vector_append("hello world")
   call z%vector_init(["a","b"])
   call z%vector_append(x)
   call x%vector_append(z)
   call x%vector_append(y)
   call x%vector_print(print_x)
   write(*,*)
   call x%vector_print(print_x,6)
contains
   subroutine print_x(x)
      class(*),intent(in)::x
      select type(x)
      type is(integer)
         write(*,"(g0,',')",advance="no")x
      type is (character(len=*))
        write(*,"(g0,',')",advance="no")"'"//x//"'"
      class default
         print*,"None Type"
      end select
   end subroutine print_x
end program main


